home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / ghostbbs.zip / BEEP.INC < prev    next >
Text File  |  1985-07-06  |  920b  |  44 lines
  1. procedure beep;
  2. type
  3.   NoteRecord = record
  4.                   C,CF,D,DF,E,F,FF,G,GF,A,AF,B: integer;
  5.                end;
  6. const
  7.   Notes: NoteRecord =
  8.           (C:1;CF:2;D:3;DF:4;E:5;F:6;FF:7;G:8;GF:9;A:10;AF:11;B:12);
  9. var
  10.   ch : char;
  11. procedure Play(Octave,Note,Duration: integer);
  12. var
  13.   Frequency : real;
  14.   I         : integer;
  15. begin
  16.   Frequency := 32.625;
  17.   for I := 1 to Octave do                { Compute C in Octave             }
  18.     Frequency := Frequency * 2;
  19.   for I := 1 to Note - 1 do              { Increase frequency Note-1 times }
  20.     Frequency := Frequency * 1.059463094;
  21.   if Duration <> 0 then
  22.   begin
  23.     Sound(Round(Frequency));
  24.     Delay(Duration);
  25.     NoSound;
  26.   end
  27.   else Sound(Round(Frequency));
  28. end;
  29.  
  30. procedure SoftAlarm;
  31. var
  32.   I: integer;
  33. begin
  34.     with Notes do
  35.     begin
  36.       Play(4,G,70);
  37.       Play(4,D,70);
  38.     end;
  39. end;
  40.  
  41. begin
  42.   Softalarm;
  43. end;
  44.